home *** CD-ROM | disk | FTP | other *** search
/ Hardcore Visual Basic 5.0 (2nd Edition) / Hardcore Visual Basic 5.0 - Second Edition (1997)(Microsoft Press).iso / Code / drive.cls < prev    next >
Text File  |  1997-06-14  |  5KB  |  165 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "CDrive"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = True
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = True
  10. Option Explicit
  11.  
  12. '$ Uses DRIVE.BAS UTILITY.BAS
  13.  
  14. Enum EDriveType
  15.     edtUnknown = 0
  16.     edtNoRoot
  17.     edtRemovable
  18.     edtFixed
  19.     edtRemote
  20.     edtCDROM
  21.     edtRAMDisk
  22. End Enum
  23.  
  24. Public Enum EErrorDrive
  25.     eeBaseDrive = 13020     ' CDrive
  26. End Enum
  27.  
  28. Private sRoot As String
  29. Private edtType As EDriveType
  30. Private iTotalClusters As Long
  31. Private iFreeClusters As Long
  32. Private iSectors As Long
  33. Private iBytes As Long
  34. Private sLabel As String
  35. Private iSerial As Long
  36. Private fDriveMissing As Boolean
  37.  
  38. Private Sub Class_Initialize()
  39.     InitAll
  40. End Sub
  41.  
  42. Public Property Get FreeBytes() As Double
  43. Attribute FreeBytes.VB_Description = "Free bytes available on the drive"
  44. Attribute FreeBytes.VB_UserMemId = -502
  45.     ' Always refresh size since free bytes might change
  46.     GetSize
  47.     If Not fDriveMissing Then
  48.         FreeBytes = CDbl(iFreeClusters) * iSectors * iBytes
  49.     End If
  50. End Property
  51.  
  52. Public Property Get TotalBytes() As Double
  53.     ' Get size info only on first access
  54.     If iTotalClusters = 0 And Not fDriveMissing Then GetSize
  55.     If Not fDriveMissing Then
  56.         TotalBytes = CDbl(iTotalClusters) * iSectors * iBytes
  57.     End If
  58. End Property
  59.  
  60. Public Property Get Label() As String
  61.     If Not fDriveMissing Then Label = sLabel
  62. End Property
  63.  
  64. Public Property Get Serial() As String
  65.     If Not fDriveMissing Then Serial = MUtility.FmtHex(iSerial, 8)
  66. End Property
  67.  
  68. Public Property Get Kind() As EDriveType
  69.     Kind = edtType
  70. End Property
  71.  
  72. Public Property Get KindStr() As String
  73.     KindStr = Choose(edtType + 1, "Unknown", "Invalid", "Floppy", _
  74.                                   "Fixed", "Network", "CD-ROM", "RAM")
  75.     If fDriveMissing Then KindStr = KindStr & " Missing"
  76. End Property
  77.  
  78. Public Property Get Number() As Integer
  79.     Number = Asc(sRoot) - Asc("A") + 1
  80.     ' Network drives are zero
  81.     If Number > 26 Then Number = 0
  82. End Property
  83.  
  84. Public Property Get Root() As Variant
  85. Attribute Root.VB_UserMemId = 0
  86.     Root = sRoot
  87. End Property
  88.  
  89. Public Property Let Root(vRootA As Variant)
  90.     ' Some properties won't work for \\server\share\ drives on Windows 95
  91.     sRoot = UCase(vRootA)  ' Convert to string
  92.     InitAll
  93. End Property
  94.  
  95. Private Sub InitAll()
  96.     sLabel = sEmpty: iSerial = 0
  97.     iSectors = 0: iBytes = 0: iFreeClusters = 0: iTotalClusters = 0
  98.     fDriveMissing = False
  99.     ' Empty means get current drive
  100.     If sRoot = sEmpty Then sRoot = Left$(CurDir$, 3)
  101.     ' Get drive type ordinal
  102.     edtType = GetDriveType(sRoot)
  103.     ' If invalid root string, try it with terminating backslash
  104.     If edtType = edtNoRoot Then edtType = GetDriveType(sRoot & "\")
  105.     Select Case edtType
  106.     Case edtUnknown, edtNoRoot
  107.         Dim iDrive As String
  108.         iDrive = Val(sRoot)
  109.         If iDrive >= 1 And iDrive <= 26 Then
  110.             sRoot = Chr$(iDrive + Asc("A") - 1) & ":\"
  111.         Else
  112.             sRoot = sEmpty
  113.         End If
  114.         ' Start over
  115.         InitAll
  116.     Case edtRemovable, edtFixed, edtRemote, edtCDROM, edtRAMDisk
  117.         ' If you got here, drive is valid, but root might not be
  118.         If Right$(sRoot, 1) <> "\" Then sRoot = sRoot & "\"
  119.         GetLabelSerial
  120.     Case Else ' Shouldn't happen
  121.         BugAssert True
  122.     End Select
  123. End Sub
  124.  
  125. Public Property Let Label(sLabelA As String)
  126.     If SetVolumeLabel(sRoot, sLabelA) Then sLabel = sLabelA
  127. End Property
  128.  
  129. Private Sub GetLabelSerial()
  130.     sLabel = String$(cMaxPath, 0)
  131.     Dim afFlags As Long, iMaxComp As Long
  132.     Call GetVolumeInformation(sRoot, sLabel, cMaxPath, iSerial, _
  133.                               iMaxComp, afFlags, sNullStr, 0)
  134.     fDriveMissing = Err.LastDllError
  135.     sLabel = MUtility.StrZToStr(sLabel)
  136. End Sub
  137.  
  138. Private Sub GetSize()
  139.     Call GetDiskFreeSpace(sRoot, iSectors, iBytes, _
  140.                           iFreeClusters, iTotalClusters)
  141.     fDriveMissing = Err.LastDllError
  142. End Sub
  143. '
  144.  
  145. #If fComponent = 0 Then
  146. Private Sub ErrRaise(e As Long)
  147.     Dim sText As String, sSource As String
  148.     If e > 1000 Then
  149.         sSource = App.ExeName & ".Drive"
  150.         Select Case e
  151.         Case eeBaseDrive
  152.             BugAssert True
  153.        ' Case ee...
  154.        '     Add additional errors
  155.         End Select
  156.         Err.Raise COMError(e), sSource, sText
  157.     Else
  158.         ' Raise standard Visual Basic error
  159.         sSource = App.ExeName & ".VBError"
  160.         Err.Raise e, sSource
  161.     End If
  162. End Sub
  163. #End If
  164.  
  165.